unit UDFRest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Db, FMTBcd, SqlExpr;

type
  TUDF = class(TDataModule)
    OldUDF: TSQLDataSet;
    NewUDF: TSQLDataSet;
    OldUDFParam: TSQLDataSet;
    NewUDFParam: TSQLDataSet;
  private
    { Private declarations }
    function UDFunc(DBType : Byte) : TDataSet;
    function Params(DBType : Byte) : TDataSet;

    function UDFName(DBType : Byte): String;
    function UDFEntry(DBType : Byte): String;
    function ModuleName(DBType : Byte) : String;
    function ParamType(DBType : Byte): String;
    function ParamSize(DBType : Byte): String;
    function ParamPos(DBType : Byte): String;
    function ParamMech(DBType : Byte) : Integer;

    procedure CreateSQLStatement(DBType: Byte; S : TStrings);

    procedure AlterUDF;
    procedure CreateUDF;
  public
    { Public declarations }
    procedure CheckUDF;
  end;

var
  UDF: TUDF;

procedure CheckUDFs(ProgBar : TProgressBar);

implementation

uses Data, ReportForm, DropRest;

{$R *.DFM}

procedure CheckUDFs(ProgBar : TProgressBar);
begin
  ProgBar.Position:=0;
  // how many functions are there ?
  UDF.NewUDF.CommandText:=
    'select count(*) as ccc from RDB$FUNCTIONS';
  UDF.NewUDF.Open;
  ProgBar.Max:=UDF.NewUDF.fieldByName('ccc').AsInteger;
  UDF.NewUDF.Close;

  UDF.NewUDF.CommandText:=
    'select * from RDB$FUNCTIONS';

  UDF.NewUDF.Open;
  UDF.OldUDF.Open;

  UDF.NewUDF.First;
  While not UDF.NewUDF.Eof do
  begin
    Application.ProcessMessages;
    ProgBar.Position:=ProgBar.Position+1;
    UDF.CheckUDF;
    UDF.NewUDF.Next;
  end;
  UDF.OldUDF.Close;
  UDF.NewUDF.Close;
end;

{ TUDF }

function TUDF.UDFunc(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewUDF;
    fcOld : Result:=OldUDF;
  end;
end;

function TUDF.Params(DBType: Byte): TDataSet;
begin
  case DBType of
    fcNew : Result:=NewUDFParam;
    fcOld : Result:=OldUDFParam;
  end;
end;

function TUDF.UDFName(DBType: Byte): String;
begin
  Result:=Trim(UDFunc(DBType).FieldByName('RDB$FUNCTION_NAME').AsString);
end;

function TUDF.UDFEntry(DBType: Byte): String;
begin
  Result:=Trim(UDFunc(DBType).FieldByName('RDB$ENTRYPOINT').AsString);
end;

function TUDF.ModuleName(DBType: Byte): String;
begin
  Result:=Trim(UDFunc(DBType).FieldByName('RDB$MODULE_NAME').AsString);
end;

function TUDF.ParamPos(DBType: Byte): String;
begin
  Result:=Trim(Params(DBType).FieldByName('RDB$ARGUMENT_POSITION').AsString);
end;

function TUDF.ParamSize(DBType: Byte): String;
begin
  Result:=Trim(Params(DBType).FieldByName('RDB$FIELD_LENGTH').AsString);
end;

function TUDF.ParamType(DBType: Byte): String;
begin
  case Params(DBType).FieldByName('RDB$FIELD_TYPE').AsInteger of
    7  : Result:='SMALLINT';
    8  : Result:='INTEGER';
    10 : Result:='FLOAT';
    14 : Result:='CHAR('+ParamSize(DBType)+')';
    27 : Result:='DOUBLE PRECISION';
    35 : Result:='DATE';
    37 : Result:='VARCHAR('+ParamSize(DBType)+')';
    40 : Result:='CSTRING('+ParamSize(DBType)+')';
  end;
end;

function TUDF.ParamMech(DBType: Byte): Integer;
begin
  Result:=Params(DBType).FieldByName('RDB$MECHANISM').AsInteger;
end;

procedure TUDF.CreateSQLStatement(DBType: Byte; S : TStrings);
var Ret, Txt : String;
begin
  S.Clear;
  S.Add('DECLARE EXTERNAL FUNCTION '+UDFName(DBType));

  Params(dbType).First;
  // first argument is output parameter
  Ret:='RETURNS '+ParamType(DBType);
  case ParamMech(DBType) of
    -1 : Ret:=Ret+' FREE_IT';
     0 : Ret:=Ret+' BY VALUE';
  end;

  Params(dbType).Next;
  While not Params(dbType).Eof do
  begin
    Txt:=ParamType(DBType);
    Params(dbType).Next;
    if not Params(dbType).Eof then Txt:=Txt+',';
    S.Add(Txt);
  end;
  S.Add(Ret);
  S.Add('ENTRY_POINT '#39+UDFEntry(DBType)+#39' MODULE_NAME '#39+ModuleName(DBType)+#39);
end;

procedure TUDF.CreateUDF;
var Ret, S : String;
begin
  DM.SQL.Clear;
  CreateSQLStatement(fcNew, DM.SQL);
//  DM.RunSQL.SQL.Add('DECLARE EXTERNAL FUNCTION '+UDFName(fcNew));
//
//  NewUDFParam.First;
//  // first argument is output parameter
//  Ret:='RETURNS '+ParamType(fcNew);
//  if ParamMech(fcNew) then Ret:=Ret+' FREE_IT' else
//    Ret:=Ret+' BY VALUE';
//
//  NewUDFParam.Next;
//  While not NewUDFParam.Eof do
//  begin
//    S:=ParamType(fcNew);
//    NewUDFParam.Next;
//    if not NewUDFParam.Eof then S:=S+',';
//    DM.RunSQL.SQL.Add(S);
//  end;
//  DM.RunSQL.SQL.Add(Ret);
//  DM.RunSQL.SQL.Add('ENTRY_POINT '#39+UDFEntry(fcNew)+#39' MODULE_NAME '#39+ModuleName(fcNew)+#39);
//
  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('UDF',Trim(UDFName(fcNew)),'not exist');
    except
      if DM.ShowReport then Rep.AddToReport('UDF',Trim(UDFName(fcNew)),'error');
    end;
  end else
  begin
    DM.AddToStrings('UDF '+UDFName(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('UDF',Trim(UDFName(fcNew)),'not exist');
  end;
end;

procedure TUDF.AlterUDF;
begin
  // I have to check dependencies
  Drop.Run(UDFName(fcNew),15,True);

  //DM.RunSQL.SQL.Clear;
  //DM.RunSQL.SQL.Add('DROP EXTERNAL FUNCTION '+UDFName(fcNew));
  CreateSQLStatement(fcNew, DM.SQL);

  if DM.AutoRepair then
  begin
    try
      //DM.ExecRunSQL;
      //DM.RunSQL.SQL.Clear;
      //CreateSQLStatement(fcNew, DM.RunSQL.SQL);
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('UDF',Trim(UDFName(fcNew)),'different');
    except
      if DM.ShowReport then Rep.AddToReport('UDF',Trim(UDFName(fcNew)),'error');
    end;
  end else
  begin
    //DM.AddToStrings('UDF '+UDFName(fcNew),DM.RunSQL.SQL);
    //DM.RunSQL.SQL.Clear;
    //CreateSQLStatement(fcNew, DM.RunSQL.SQL);
    DM.AddToStrings('UDF '+UDFName(fcNew),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('UDF',Trim(UDFName(fcNew)),'different');
  end;

end;

procedure TUDF.CheckUDF;
var Ok : Boolean;
    OldSt,
    NewSt : TStringList;
begin
  // UDF exist ?
  NewUDFParam.ParamByName('UDFNAME').AsString:=UDFName(fcNew);
  NewUDFParam.Open;
  OldUDF.Close;
  OldUDF.ParamByName('FNAME').AsString:=UDFName(fcNew);
  OldUDF.Open;
  if UDFName(fcOld)=UDFName(fcNew) then
  begin
    // check structure
    OldUDFParam.ParamByName('UDFNAME').AsString:=UDFName(fcNew);
    OldUDFParam.Open;
    OldSt:=TstringList.Create;
    NewSt:=TstringList.Create;
    CreateSQLStatement(fcOld,OldSt);
    CreateSQLStatement(fcNew,NewSt);
    if not OldSt.Equals(NewSt) then
    begin
      AlterUDF;
      //if DM.ShowReport then Rep.AddToReport('UDF',UDFName(fcNew),'different');
    end;
    OldSt.Free;
    NewSt.Free;
    OldUDFParam.Close;
  end else
  begin
    CreateUDF;
    //if DM.ShowReport then Rep.AddToReport('UDF',UDFName(fcNew),'not exist');
  end;
  NewUDFParam.Close;
end;

end.
